perm filename TOKEN.SAI[PUB,TES] blob
sn#129310 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("TOKEN")
00200
00300 COMMENT
00400
00500 Tokenization, symbol table lookup of identifiers,
00600 declaring and disdeclaring identifiers.
00700
00800 PASS is the main routine. It sets THISWD←THATWD
00900 and THATWD← first token in INPUTSTR --- almost. There
01000 are numerous exceptions to this general rule. The
01100 main one is that if THISWD is a delimiter, THATWD is
01200 left empty. If a macro name is encountered, the macro is
01300 expanded.
01400
01500 Macros IPASS(integer) and SPASS(string) allow PASS to be
01600 called in an expression, returning its
01700 pseudo-argument as its pseudo-value.
01800
01900 ;
02000
02100 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE TOKEN! ;$"#
00200 BEGIN "TOKEN!"
00300 SETSYM ; XSYMNO ← SYMNO ; comment Initialize the symbol table;
00500 FOR J ← 0 THRU 127 DO
00600 BEGIN DPB(MISCQ, FAMILY(J)) ; DPB(0, SPECIES(J)) END ;
00700 FAMILYHAS(LETTQ, "ABCDEFGHIJKLMNOPQRSTUVWXYZ!") ;
00800 FAMILYHAS(LETTQ, "abcdefghijklmnopqrstuvwxyz_") ;
00900 FAMILYHAS(DIGQ, "0123456789" ) ;
01000 FAMILYHAS(EMPTYQ, '0 & ALTMODE & RUBOUT) ;
01100 FAMILYHAS(TERQ, RCBRAK&";),]⊂" ) ;
01200 FAMILYHAS(QUOTEQ, """'" ) ;
01300 FAMILYHAS(DOLLARQ, "$" ) ;
01400 FAMILYHAS(BROKQ, "[" ) ;
01500 FAMILYHAS(MULQ, "*/%&" ) ;
01600 FAMILYHAS(ADDQ, "+-≡↑⊗" ) ;
01700 FAMILYHAS(RELQ, "<>=≤≥≠" ) ;
01800 FAMILYHAS(NOTQ, "¬" ) ;
01900 FAMILYHAS(ANDQ, "∧" ) ;
02000 FAMILYHAS(ORQ, "∨" ) ;
02100 FAMILYHAS(MISCQ, " :←(∞@|ε" ) ;
02200 FOR S ← "∧AND", "∨OR", "¬NOT", "/DIV", "≡EQV", "⊗XOR",
02300 "≡ABS", "⊗LENGTH", "≤LEQ", "≥GEQ", "≠NEQ" DO
02400 BIND(DECLARE(SYMNUM(S[2 TO ∞]), INTERNTYPE), S+200) ;
02500 COMMENT, equate with special character ;
02600 J ← RUBOUT ;
02700 FOR S ← ODDQ&0&"EVEN", ODDQ&1&"ODD",
02800 BOUNDQ&0&"MAX", BOUNDQ&1&"MIN", MULQ&2&"MOD", ADDQ&5&"XLENGTH" DO
02900 BEGIN
03000 INTEGER TEMP ; COMMENT SAIL BUG -- THANKS RKJ ;
03100 BIND(DECLARE(SYMNUM(S[3 TO ∞]), INTERNTYPE), (J←J+1)+200) ;
03200 DPB(TEMP←S[1 FOR 1], FAMILY(J)) ;
03300 DPB(TEMP←S[2 FOR 1], SPECIES(J)) ;
03400 END ;
03500 DCLR!ID ← FALSE ;
03600 END "TOKEN!" ;
00100 COMMENT
00200 SYMSER.SAI package -- LOOKUP and ENTER procedures for hashed
00300 symbol tables -- STRINGS -- uses linear quotient hash conflict resolution.
00400
00500 REQUIRED --
00600 1. DEFINE SYMNO="1 less than some prime number big
00700 enough to hold all entries".
00800
00900 WHAT YOU GET ---
01000 1. An array, SYM[0:SYMNO-1], to hold the (STRING) symbols
01100 you enter.
01200
01300 2. A parallel array, NUMBER, to hold the (INTEGER) values which
01400 get associated with each string, during ENTERSYM. If you want
01500 more complex symbol entries, use the NUMBER array to hold some
01600 sort of descriptors t the more complex entries.
01700
01800 3. An integer variable, SYMBOL, which LOOKSYM (below) will set
01900 to the index of the found string, etc.
02000
02100 4. An integer variable, ERRFLAG, set to TRUE if errors occur in ENTERSYM.
02200
02300 5. A Procedure, FLAG←LOOKSYM("A") which returns:
02400 TRUE if the string is already present in the SYM table, whence:
02500 SYMBOL is the index of the found string/value in the arrays.
02600 The form of TRUE returned is: XWD -1,symbol index.
02700 FALSE if the symbol is not found, whence:
02800 SYMBOL is -1 (table full), or is the index in the table
02900 which should be used to enter the string (see below).
03000
03100 6. A Procedure, ENTERSYM("SYM",VAL).
03200 This should be called just after a LOOKSYM, called with the
03300 same string. ENTERSYM will use the value of SYMBOL produced by
03400 LOOKSYM, so this is important (more efficient than doing it over).
03500 Entersym checks for symbol full or duplicate symbol -- if either
03600 error occurs, it types a message and sets ERRFLAG TRUE.
03700 Entersym puts SYM and VAL into SYM/NUMBER arrays at SYMBOL index.
03800
03900 7. A Procedure, SETSYM, which initializes the table. The indices
04000 returned by LOOKSYM will range from 1 to SYMNO-1 -- 0 is not
04100 used, for a reason which I do not remember.
04200
04300 Average symbol table lookup requires about two probes into the symbol
04400 table, for tables which are kept less than about 80% full. More
04500 dense tables will not degrade this figure too much.
04600 ;
00100 PUBLIC SIMPLE PROCEDURE BIND(INTEGER LOC, NEWIX) ;$"#
00200 BEGIN "BIND"
00300 IF LOC = SYMTEXT THEN IXTEXT ← NEWIX
00400 ELSE IF LOC = SYMPAGE THEN BEGIN IXPAGE ← NEWIX ; PATPAGE ← PATT!STRS(IXPAGE) END ;
00500 DPB(NEWIX, IXN(LOC)) ; IF LDB(TYPEN(LOC)) GEQ 11 THEN DPB(LOC, BIXNUM(NEWIX)) ;
00600 END "BIND" ;
00100 PUBLIC STRING SIMPLE PROCEDURE CAPITALIZE(STRING MIXEDCASE) ;$"#
00200 BEGIN "CAPITALIZE"
00300 INTEGER C ; STRING S ; S ← 0&MIXEDCASE ; LOPP(S) ; C ← LENGTH(MIXEDCASE) ; IF NOT C THEN RETURN(NULL);
00400 START!CODE "CAPIT" LABEL NEXC ; MOVE 1, S ; MOVE 2, C ;
00500 NEXC: ILDB 3, 1 ; LDB 3, UPCAS3 ; DPB 3, 1 ; SOJG 2, NEXC ;
00600 END "CAPIT" ; RETURN(S) ;
00700 END "CAPITALIZE" ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE DECLARE(INTEGER LOC, NEWTYPE) ;$"#
00200 IF ON THEN
00300 BEGIN "DECLARE"
00400 INTEGER NEWDEPTH, OLDDEPTH ; LABEL PURGE ;
00500 BYTEWD ← NUMBER[LOC] ;
00600 NEWDEPTH ← CASE NEWTYPE OF (0,1,DEPTH,0,DEPTH,0,0,0,0,0,1,DEPTH,DEPTH,DEPTH,DEPTH) ;
00700 IF LOC = SYMTEXT AND NEWTYPE NEQ AREATYPE OR LOC = SYMPAGE AND NEWTYPE NEQ COUNTERTYPE THEN
00800 BEGIN
00900 WARN("=",SYM[LOC] & " may only be type " & (IF LOC=SYMTEXT THEN "AREA" ELSE "COUNTER")) ;
01000 GO TO PURGE ;
01100 END ;
01200 IF LDB(TYPEWD(BYTEWD)) THEN
01300 IF (OLDDEPTH ← LDB(DEPTHWD(BYTEWD))) < 1 THEN
01400 BEGIN
01500 WARN("=","You may not redeclare reserved word " & SYM[LOC]) ;
01600 PURGE: LOC ← SYMNUM("(Purged)" & SYM[LOC]) ;
01700 END
01800 ELSE IF OLDDEPTH < NEWDEPTH THEN
01900 BEGIN
02000 PUSHI(NUMWDS, NUMTYPE) ;
02100 OLD!NUMBER(IHED) ← BYTEWD ;
02200 END
02300 ELSE IF OLDDEPTH = 1 THEN
02400 BEGIN
02500 WARN("=",<"You may not redeclare" & SYM[LOC] & ", a global VARIABLE or PORTION">) ;
02600 GO TO PURGE ;
02700 END
02800 ELSE IF OLDDEPTH=NEWDEPTH THEN
02900 DISDECLARE(LOC, LDB(TYPEWD(BYTEWD)), LDB(IXWD(BYTEWD)))
03000 ELSE WARN("=",<"Global " & SYM[LOC] & " redeclaring local">) ;
03100 NUMBER[LOC] ← (NEWDEPTH ROT -5) LOR (LOC LSH 18) LOR (NEWTYPE LSH 14) ;
03200 RETURN(LOC) ;
03300 END "DECLARE" ;
00100 PUBLIC SIMPLE PROCEDURE DISDECLARE(INTEGER SYMB, OLDTYPE, OLDIX) ;$"#
00200 IF ON THEN
00300 BEGIN "DISDECLARE"
00400 LABEL LOCAL; RKJ: 1-8-74;
00500 CASE OLDTYPE OF
00600 BEGIN
00700 [LOCALTYPE] LOCAL:BEGIN SSTK[OLDIX]←NULL; IF IX=SHED THEN SHED←SHED-1 END ;
00800 [INTERNTYPE] WARN("=",SYM[SYMB]&" Redeclared") ;
00900 [AREATYPE] CLOSEAREA(OLDIX,TRUE);
01000 [COUNTERTYPE] CLOSECOUNTER(OLDIX,TRUE) ;
01100 [MACROTYPE] BEGIN OLDIX←BODY(OLDIX); GO TO LOCAL END RKJ: Delete redeclared macros 1-8-74;
01200 END ;
01300 END "DISDECLARE";
00100 PRIVATE PROCEDURE ENTERSYM(STRING WORD; INTEGER VAL) ;$"#
00200 COMMENT ROUTINE TO ENTER A SYMBOL IN THE SYMBOL TABLE.
00300 IT ENTERS THE PREVIOUS WORD SCANNED BY GETWORD.
00400 "SYMBOL" IS THE POINTER INTO THE ARRAY WHERE THE
00500 SYMBOL IS STORED.;
00600 BEGIN "ENTERSYM"
00700 IF LENGTH(SYM[SYMBOL]) OR SYMBOL<0 THEN
00800 BEGIN
00900 ERRFLAG←1;
01000 IF SYMBOL GEQ 0 THEN OUTSTR( "DUPLICATE SYMBOL " & WORD & CRLF)
01100 ELSE OUTSTR( "SYMBOL TABLE FULL" & CRLF)
01200 END;
01300 SYM[SYMBOL]←WORD;
01400 NUMBER[SYMBOL]←VAL;
01500 END "ENTERSYM";
00100 PUBLIC SIMPLE PROCEDURE FAMILYHAS(INTEGER FAMNUM; STRING MEMBERS) ;$"#
00200 BEGIN "FAMILYHAS"
00300 INTEGER SPECIE, CHAR ;
00400 SPECIE ← -1 ;
00500 WHILE FULSTR(MEMBERS) DO
00600 BEGIN
00700 DPB(FAMNUM, FAMILY(CHAR ← LOP(MEMBERS))) ;
00800 DPB(SPECIE ← SPECIE+1, SPECIES(CHAR)) ;
00900 END ;
01000 END "FAMILYHAS" ;
00100 PRIVATE INTEGER PROCEDURE LOOKSYM(STRING A) ;$"#
00200 BEGIN "LOOKSYM"
00300 INTEGER H,Q,R;
00400
00500 H←CVASC(A) +LENGTH(A) LSH 6;
00600
00700 Comment Linear Quotient Hash Conflict Resolution method, see
00800 CACM 13,11 (1970), page 675;
00900
01000 R←SYMBOL←(H←ABS(H⊗(H LSH 2))) MOD (SYMNO+1);
01100 IF EQU(SYM[SYMBOL],A) THEN RETURN((-1 LSH 18)+SYMBOL);
01200 IF NULSTR(SYM[SYMBOL]) THEN RETURN(0);
01300
01400 Q←H%(SYMNO+1) MOD (SYMNO+1);
01500 FOR H←1 STEP 1 UNTIL SYMNO DO BEGIN "LK1"
01600 IF (SYMBOL←SYMBOL+H)>SYMNO THEN SYMBOL←SYMBOL-(SYMNO+1);
01700 IF EQU(SYM[SYMBOL],A) THEN RETURN((-1 LSH 18)+SYMBOL);
01800 IF NULSTR(SYM[SYMBOL]) THEN RETURN(0);
01900 END "LK1";
02000 SYMBOL←-1; RETURN(0);
02100 END "LOOKSYM";
00100 PUBLIC RECURSIVE STRING PROCEDURE PASS ;$"#
00200 comment Value is always NULL ;
00300 BEGIN COMMENT Load up THISWD,THISTYPE, THATWD,THATTYPE, SYMB, and IX
00400 for the parser. Calls CHUNK recursively! PASS will expand macro
00500 calls, replace macro/response arguments with their actual values,
00600 and skip over comments. ;
00700 PRELOAD!WITH 0, [3]3, 2, [4]3, 0, 1, 0, 4, [5]0, 5, 0, 0, 6, [7]0, 7, 0 ;
00800 OWN INTEGER ARRAY SCANTYPE[-15:15] ; comment, computes small case index ;
00900 BOOLEAN FINAL ;
01000 DO BEGIN "LOAD WD 0"
01100 IF NOT THATISFULL THEN RDENTITY ;
01200 THISWD ← THATWD ;
01300 THISTYPE ← IF THATTYPE THEN THATTYPE comment, non-identifier ;
01400 ELSE IF SYMLOOK(THATWD) THEN LDB(TYPEN(SYMBOL))
01500 ELSE 0 ; comment, undeclared identifier ;
01600 IF THISTYPE NEQ -TERQ THEN RDENTITY ;
01700 IF THISISID THEN
01800 BEGIN "IDENTIFIER"
01900 SYMB ← SYMBOL ;
02000 IF NOT DCLR!ID AND THATISID AND SYMLOOK(THISWD & SP & THATWD) THEN
02100 BEGIN comment, two-word macro name ;
02200 THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MACROTYPE ;
02300 IX ← LDB(IXN(SYMBOL)) ; RDENTITY ;
02400 END
02500 ELSE BEGIN SYMBOL←SYMB ; IF NULSTR(SYM[SYMB]) THEN ENTERSYM(THISWD,0) ; IX←LDB(IXN(SYMB)) ;END ;
02600 END "IDENTIFIER" ;
02700 FINAL ← FALSE ;
02800 DO CASE SCANTYPE[THISTYPE] OF
02900 BEGIN COMMENT DETECT ;
03000 COMMENT 0 ... Nothing to do ; BEGIN END ;
03100 COMMENT 1 ... $ ; IF NEXTSCH(<(>) THEN
03200 BEGIN EMPTYTHAT ; THISWD←"⊂" ;
03300 IX ← LDB(SPECIES(THISWD)) ; THISTYPE ← -TERQ ;
03400 END
03500 ELSE IX←LDB(SPECIES(THISWD)) ;
03600 COMMENT 2 ... < Family ; IF ITSCH "[]"([<]) AND NEXTSCH "[]"([<]) THEN
03700 BEGIN "<<COMMENT>>" SETBREAK(LOCAL!TABLE, ">"&RCBRAK&LF, NULL, "IS") ;
03800 DO RD(LOCAL!TABLE) UNTIL BRC=">" AND INPUTSTR=">" OR BRC=RCBRAK AND INPUTSTR=VT ;
03900 IF BRC=">" THEN RD(ONE!CHAR)
04000 ELSE BEGIN WARN("=","Unterminated <<comment>>") ; INPUTSTR←BRC&INPUTSTR END ;
04100 EMPTYTHIS ; EMPTYTHAT ;
04200 END "<<COMMENT>>"
04300 ELSE IX ← LDB(SPECIES(THISWD)) ; COMMENT relational operator ;
04400 COMMENT 3 ... Expression Operators ; IX ← LDB(SPECIES(THISWD)) ;
04500 COMMENT 4 ... Terminal ;
04600 BEGIN
04700 IF ITSCH(<]>) AND INPUTSTR="$" THEN
04800 BEGIN LOPP(INPUTSTR) ; THISWD ← RCBRAK END ;
04900 EMPTYTHAT ; IX ← LDB(SPECIES(THISWD)) ;
05000 END ; Comment NOTE!! }),]⊂;
05100 COMMENT 5 ... internal variable ; IF NOT DCLR!ID AND IX GEQ 200 THEN
05200 BEGIN "OPERATOR"
05300 IX ← IX-200 ; comment e.g., NOT → ;
05400 THISTYPE ← -LDB(FAMILY(IX)) ;
05500 IX ← LDB(SPECIES(IX)) ;
05600 END "OPERATOR" ;
05700 COMMENT 6 ... reserved word ; IF IX=IXCOMMENT AND NOT DCLR!ID THEN
05800 BEGIN "COMMENT"
05900 INPUTSTR ← LIT!ENTITY & INPUTSTR ;
06000 DO RD(TO!SEMI!SKIP) UNTIL BRC=";" OR INPUTSTR=VT ;
06100 IF BRC NEQ ";" THEN BEGIN WARN("=","Unterminated COMMENT;") ; INPUTSTR←BRC&INPUTSTR END ;
06200 EMPTYTHIS ; EMPTYTHAT ; ;
06300 END "COMMENT" ;
06400 COMMENT 7 ... macro name ;
06500 IF NOT DCLR!ID AND ODDMAC(IX)<2 THEN APPLYTOARGUMENTS(ON OR ODDMAC(IX), FALSE) ; TES 8/19/74 ;
06600 END COMMENT DETECT ; UNTIL (FINAL ← NOT FINAL) ;
06700 END "LOAD WD 0" UNTIL THISISFULL ;
06800 RETURN(NULL) ;
06900 END "PASS" ;
00100 PUBLIC SIMPLE PROCEDURE RDENTITY ;$"#
00200 BEGIN Comment Sets THATWD, THATTYPE, LIT!ENTITY, LIT!TRAIL ;
00300 STRING SEGMENT, SOURCE ; BOOLEAN DUN, TEXTLN ; INTEGER CC, FAM ; LABEL RETRY ;
00400 TEXTLN ← FALSE ; RETRY: IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ;
00500 SOURCE ← INPUTSTR ;
00600 FAM ← LDB(FAMILY(SOURCE)) ;
00700 CASE FAM MIN QUOTEQ+1 OF
00800 BEGIN COMMENT BY FAMILY ;
00900 COMMENT 0 ... Letter ;
01000 BEGIN "BUILD ID"
01100 CC ← LENGTH(SEGMENT ← SCAN(SOURCE, ALPHA, BRC)) ;
01200 THATWD ← CAPITALIZE(SEGMENT);
01300 THATTYPE ← 0 ;
01400 END "BUILD ID" ;
01500 COMMENT 1 ... Digit ;
01600 BEGIN "BUILD INTEGER"
01700 CC ← LENGTH(THATWD ← "0" & SCAN(SOURCE, DIGITA, BRC)) - 1 ;
01800 THATTYPE ← -1 ;
01900 END "BUILD INTEGER" ;
02000 COMMENT 2 ... EMPTYQ ; IMPOSSIBLE("RDENTITY") ;
02100 COMMENT 3 ... Terminal ;
02200 BEGIN "MAYBE TEXT"
02300 IF LDB(SPECIES(THATWD ← LOP(SOURCE))) = 0 THEN TEXTLN ← TRUE ;
02400 CC ← 1 ; THATTYPE ← -TERQ ;
02500 END "MAYBE TEXT" ;
02600 COMMENT 4 ... Quote ;
02700 IF SOURCE = """" THEN
02800 BEGIN "STRING CONSTANT"
02900 DUN ← FALSE ; THATWD ← "7" ; LOPP(SOURCE) ; CC ← 1 ; COMMENT skip " ;
03000 DO BEGIN "TO NEXT QUOTE"
03100 SEGMENT ← SCAN(SOURCE, TO!QUOTE!APPD, BRC) ;
03200 CC ← CC + LENGTH(SEGMENT) ;
03300 IF BRC NEQ """" THEN
03400 BEGIN "QERROR"
03500 THATWD ← THATWD & SEGMENT[1 TO ∞-1] ; DUN ← TRUE ;
03600 WARN("=","Omitted Right Quote From: "&THATWD) ;
03700 END "QERROR"
03800 ELSE IF SOURCE = """" THEN
03900 BEGIN "INTERNALQUOTE"
04000 THATWD ← THATWD & SEGMENT ;
04100 LOPP(SOURCE) ; CC ← CC + 1 ; COMMENT skip second " ;
04200 END "INTERNALQUOTE"
04300 ELSE
04400 BEGIN "END STRING"
04500 THATWD ← THATWD & SEGMENT[1 TO ∞-1] ;
04600 DUN ← TRUE ;
04700 END "END STRING"
04800 END "TO NEXT QUOTE"
04900 UNTIL DUN ;
05000 THATTYPE ← -1 ;
05100 END "STRING CONSTANT"
05200 ELSE
05300 BEGIN "OCTAL CONSTANT"
05400 LOPP(SOURCE) ; THATTYPE ← -1 ;
05500 CC ← LENGTH(SEGMENT ← SCAN(SOURCE, DIGITA, BRC)) + 1 ;
05600 THATWD ← "8" & (DUMMY←CVO(SEGMENT)) ; COMMENT a one-character string ;
05700 IF NOT INPICHAR THEN TES 12/6/73 ;
05800 IF DUMMY='0 OR '11 LEQ DUMMY LEQ '15 OR DUMMY=ALTMODE OR DUMMY=RUBOUT THEN
05900 BEGIN
06000 WARN("ILL OCTAL",
06100 "Illegal octal constant (represents illegal character) "&CVOS(DUMMY)) ;
06200 THATWD ← "7" ;
06300 END ;
06400 END "OCTAL CONSTANT" ;
06500 COMMENT 5 ... Other ;
06600 BEGIN "SINGLE CHARACTER"
06700 THATTYPE ← -FAM ; CC ← 1 ; THATWD ← LOP(SOURCE) ;
06800 IF FAM = MISCQ THEN CASE LDB(SPECIES(THATWD)) OF
06900 BEGIN
07000 [4] COMMENT ∞ ; BEGIN THATTYPE ← 0 ; THATWD ← "!INF" END ;
07100 [0] BEGIN "ILL CHAR"
07200 WARN("=","Extraneous '" & CVOS(THATWD) & " in command line") ;
07300 LOPP(INPUTSTR) ; GO TO RETRY ;
07400 END "ILL CHAR" ;
07500 [MISCMAX]
07600 END ;
07700 END "SINGLE CHARACTER" ;
07800 END ; COMMENT BY FAMILY ;
07900 LIT!ENTITY ← INPUTSTR[1 TO CC] ;
08000 INPUTSTR ← SOURCE ;
08100 LIT!TRAIL ← IF TEXTLN THEN NULL ELSE IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ELSE NULL ;
08200 END "RDENTITY" ;
00100 PRIVATE PROCEDURE SETSYM ;$"#
00200 BEGIN
00300 INTEGER I;
00400 FOR I←-1 STEP 1 UNTIL SYMNO DO SYM[I]←NULL;
00500 SYM[0]←" ";
00600 ERRFLAG←FALSE
00700 END "SETSYM";
00100 PUBLIC BOOLEAN SIMPLE PROCEDURE SIMLOOK(STRING NAME) ;$"#
00200 comment, SIMilar to SYMLOOK, but sets SYMTYPE and SYMIX ;
00300 IF SYMLOOK(NAME) THEN
00400 BEGIN
00500 BYTEWD ← NUMBER[SYMBOL] ;
00600 SYMTYPE ← LDB(TYPEWD(BYTEWD)) ; SYMIX ← LDB(IXWD(BYTEWD)) ;
00700 RETURN(TRUE) ;
00800 END
00900 ELSE RETURN(FALSE) ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE SIMNUM(STRING NAME) ;$"#
00200 BEGIN "SIMNUM" comment, SIMilar to SYMNUM, but uses SIMLOOK instead of SYMLOOK ;
00300 IF NOT SIMLOOK(NAME) THEN ENTERSYM(NAME, SYMTYPE←SYMIX←0) ;
00400 RETURN(SYMBOL) ;
00500 END "SIMNUM" ;
00100 PUBLIC BOOLEAN SIMPLE PROCEDURE SYMLOOK(STRING NAME) ;$"#
00200 BEGIN "SYMLOOK" comment same as LOOKSYM, but if hash table full, expands it and does linear search ;
00300 comment don't search if it's already here;
00400 IF SYMBOL>0 AND EQU(SYM[SYMBOL],NAME) OR LOOKSYM(NAME) THEN RETURN(TRUE) ;
00500 IF SYMBOL>0 THEN RETURN(FALSE) ; comment it's not there, and table's not full;
00600 FOR SYMBOL ← SYMNO STEP 1 WHILE SYMBOL LEQ XSYMNO AND FULSTR(SYM[SYMBOL]) AND NOT EQU(SYM[SYMBOL],NAME) DO ;
00700 IF SYMBOL > XSYMNO THEN
00800 BEGIN
00900 SGROW(SYM, SYMIDA, XSYMNO, 1000, "Symbol Table Full") ; SMAKEBE(SYMIDA, SYM) ;
01000 ZEROSTRINGS(1000, SYM[XSYMNO-999]) ;
01100 GROW(NUMBER, NUMBIDA, DUMMY, 1000, NULL) ; MAKEBE(NUMBIDA, NUMBER) ;
01200 ZEROWORDS(1000, NUMBER[XSYMNO-999]); RKJ: 1-3-74;
01300 IF XSYMNO GEQ TWO(13) THEN WARN(NULL,"Symbol Table Enormopotamus. I give up.") ;
01400 RKJ: SUPERFLUOUS 1-3-74 FOR SYMBOL ← XSYMNO-999 THRU XSYMNO DO SYM[SYMBOL] ← NULL ;
01500 DUMMY←XSYMNO+1; SYMBOL ← XSYMNO - 999 ; RETURN(FALSE) ;
01600 END
01700 ELSE RETURN(FULSTR(SYM[SYMBOL])) ;
01800 END "SYMLOOK" ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE SYMNUM(STRING NAME) ;$"#
00200 BEGIN "SYMNUM" comment looks up a symbol, and if not there, enters it. returns subscript;
00300 IF NOT SYMLOOK(NAME) THEN ENTERSYM(NAME, 0) ;
00400 RETURN(SYMBOL) ;
00500 END "SYMNUM" ;
00600
00100 FINISHED
00200
00300 ENDOF("TOKEN")